home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / intrfc70.zip / HEAD.PAS < prev    next >
Pascal/Delphi Source File  |  1994-03-16  |  7KB  |  213 lines
  1. unit head;
  2. {$I SWITCHES.INC}
  3. { NENI cely tisk DPMI, WINDOWS }
  4. { Header declarations and dumper }
  5. interface
  6.  
  7. uses globals,util,dump;
  8.  
  9. type
  10.   unit_flags = set of (ieee_reals,overlays,windows60,i286,moveable,
  11.                        f20,preload,f80,
  12.                        dpmi,windows,f400,f800,
  13.                        discardable,f2000,f4000,f8000);
  14. {$IFDEF UNIT60}
  15. const
  16.   tpu_file_id = 'TPU9';
  17. type
  18.   header_ptr = ^header_rec;
  19.   header_rec = record
  20.     file_id: array[0..3] of char; { 0-3 }
  21.     i4,                           { 4-5 }
  22.     i6,                           { 6-7 }
  23.     ofs_this_unit,                { 8-9 }
  24.     ofs_hashtable,                { A-B }
  25.     ofs_entry_pts,                { C-D }
  26.     ofs_code_blocks,              { E-F }
  27.     ofs_const_blocks,             {10-11}
  28.     ofs_var_blocks,               {12-13}
  29.     ofs_dll_list,                 {14-15}
  30.     ofs_unit_list,                {16-17}
  31.     ofs_src_name,                 {18-19}
  32.     ofs_line_lengths,             {1A-1B}
  33.     sym_size,                     {1C-1D}
  34.     code_size,                    {1E-1F}
  35.     const_size,                   {20-21}
  36.     reloc_size,                   {22-23}
  37.     const_reloc_size,             {24-25}
  38.     var_size,                     {26-27}
  39.     ofs_full_hash: word;          {28-29}
  40.     flags : unit_flags;           {2A-2B}
  41.     other : array[$2C..$3F] of byte; {2C-3F}
  42.   end;
  43. {$ELSE}
  44.   {BP 7.0}
  45. const
  46.   tpu_file_id = 'TPUQ';
  47.  
  48. type
  49.   header_ptr = ^header_rec;
  50.   header_rec = record
  51.     file_id: array[0..3] of char; { 0-3 }
  52.     i4,                           { 4-5 }
  53.     i6,                           { 6-7 }
  54.     ofs_this_unit,                { 8-9 }
  55.     ofs_hashtable,                { A-B }
  56.     ofs_entry_pts,                { C-D }
  57.     ofs_code_blocks,              { E-F }
  58.     ofs_const_blocks,             {10-11}
  59.     ofs_var_blocks,               {12-13}
  60.     ofs_dll_list,                 {14-15}
  61.     ofs_unit_list,                {16-17}
  62.     ofs_src_name,                 {18-19}
  63.     ofs_line_count,               {1A-1B}
  64.     ofs_line_lengths,             {1C-1D}
  65.     sym_size,                     {1E-1F}
  66.     browser_size,                 {20-21}
  67.     code_size,                    {22-23}
  68.     const_size,                   {24-25}
  69.     reloc_size,                   {26-27}
  70.     const_reloc_size,             {28-29}
  71.     var_size,                     {2A-2B}
  72.     ofs_full_hash: word;          {2C-2D}
  73.     flags : unit_flags;           {2E-2F}
  74.     object_type_list,             {30-31}   { offset of last object type def
  75.                                       previous object in previous_object_def }
  76.     br_defs_end,                  {32-33}
  77.     br_symbol_refxx1 : word;      {34-35}
  78.     next_tpu,                     {36-39} { next pointers used in TPUMOVER }
  79.     browser_ptr,                  {3A-3D}
  80.     code_ptr,                     {3E-41}
  81.     const_ptr,                    {42-45}
  82.     reloc_ptr,                    {46-49}
  83.     const_reloc_ptr : pointer;    {4A-4D}
  84.     other : array[$4e..$5F] of byte; {4E-3F}
  85.   end;
  86. {$ENDIF}
  87.  
  88. var
  89.   header : header_ptr;
  90.  
  91. procedure print_header;
  92.  
  93. implementation
  94.  
  95. procedure print_header;
  96. var
  97.   i:integer;
  98.   new_flags : unit_flags;
  99.  
  100. procedure WriteSegments;
  101. begin
  102.   if moveable in new_flags then
  103.     write('Moveable ')
  104.   else
  105.     write('Fixed ');
  106.   if preload in new_flags then
  107.     write('Preload ')
  108.   else
  109.     write('Demandload ');
  110.   if discardable in new_flags then
  111.     write('Discardable ')
  112.   else
  113.     write('Permanent ');
  114.   new_flags := new_flags - [moveable,preload,discardable];
  115. end;
  116.  
  117. begin
  118.   with header^ do
  119.   begin
  120.     writeln('file_id:':20,file_id);
  121.     writeln('i4:':20,hexwordblank(i4));
  122.     writeln('i6:':20,hexwordblank(i6));
  123.     writeln('ofs_this_unit:':20,hexwordblank(ofs_this_unit));
  124.     writeln('ofs_hashtable:':20,hexwordblank(ofs_hashtable));
  125.     writeln('ofs_entry_pts:':20,hexwordblank(ofs_entry_pts));
  126.     writeln('ofs_code_blocks:':20,hexwordblank(ofs_code_blocks));
  127.     writeln('ofs_const_blocks:':20,hexwordblank(ofs_const_blocks));
  128.     writeln('ofs_var_blocks:':20,hexwordblank(ofs_var_blocks));
  129.     writeln('ofs_dll_list:':20,hexwordblank(ofs_dll_list));
  130.     writeln('ofs_unit_list:':20,hexwordblank(ofs_unit_list));
  131.     writeln('ofs_src_name:':20,hexwordblank(ofs_src_name));
  132. {$IFNDEF UNIT60}
  133.       writeln('ofs_line_count:':20,hexwordblank(ofs_line_count));
  134. {$ENDIF}
  135.     writeln('ofs_line_lengths:':20,hexwordblank(ofs_line_lengths));
  136.     writeln('sym_size:':20,hexwordblank(sym_size));
  137. {$IFNDEF UNIT60}
  138.     writeln('browser_size:':20,hexwordblank(browser_size));
  139. {$ENDIF}
  140.     writeln('code_size:':20,hexwordblank(code_size));
  141.     writeln('const_size:':20,hexwordblank(const_size));
  142.     writeln('reloc_size:':20,hexwordblank(reloc_size));
  143.     writeln('const_reloc_size:':20,hexwordblank(const_reloc_size));
  144.     writeln('var_size:':20,hexwordblank(var_size));
  145.     writeln('ofs_full_hash:':20,hexwordblank(ofs_full_hash));
  146. {$IFNDEF UNIT60}
  147.     writeln('object_type_list:':20,hexwordblank(object_type_list));
  148.     writeln('br_defs_end:':20,hexwordblank(br_defs_end));
  149.     writeln('br_symbol_refxx1:':20,hexwordblank(br_symbol_refxx1));
  150. {$ENDIF}
  151.  
  152.     write('flags:':20);
  153.     new_flags := flags;
  154.  
  155.     if ieee_reals in new_flags then
  156.       write('N+':4)
  157.     else
  158.       write('N-':4);
  159.     Exclude(new_flags,ieee_reals);
  160.     if i286 in new_flags then
  161.       write('G+':4)
  162.     else
  163.       write('G-':4);
  164.     Exclude(new_flags,i286);
  165.     if overlays in new_flags then
  166.       write('O+':4)
  167.     else
  168.       write('O-':4);
  169.     Exclude(new_flags,overlays);
  170.     writeln;
  171.  
  172.     if windows60 in new_flags then
  173.     begin
  174.       write('TPW 1.X options $C:':20);
  175.       WriteSegments;
  176.       Exclude(new_flags,windows60);
  177.     end
  178.     else if windows in new_flags then
  179.     begin
  180.       write('TPW options $C:':20);
  181.       WriteSegments;
  182.       Exclude(new_flags,windows);
  183.     end
  184.     else if dpmi in new_flags then
  185.     begin
  186.       write('BP DPMI options $C:':20);
  187.       WriteSegments;
  188.       Exclude(new_flags,dpmi);
  189.     end
  190.     else
  191.     begin
  192.       write('TP for DOS options:':20);
  193.  
  194.  
  195.     end;
  196.  
  197.     if new_flags <> [] then
  198.       WriteError('unknown flags '+hexword(word(new_flags)));
  199.     writeln;
  200.     writeln;
  201.  
  202.     writeln('Other: ');
  203. {$IFDEF UNIT60}
  204.     dumpbytes(header^,$30,$50-$30)
  205. {$ELSE}
  206.     dumpbytes(header^,ofs(header^.next_tpu)-ofs(header^),
  207.             sizeof(header^)-(ofs(header^.next_tpu)-ofs(header^)));
  208. {$ENDIF}
  209.   end;
  210. end;
  211.  
  212. end.
  213.